perm filename MAIL[NEW,LSP] blob
sn#531337 filedate 1980-08-21 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Mail for Maclisp. Derek Oppen 1978.
C00004 ENDMK
Cā;
;;; Mail for Maclisp. Derek Oppen 1978.
(DEFPROP MAIL
(LAMBDA (L)
(PROG (DEST MESSAGE)
(COND
((NULL L)
(PRINC (QUOTE |Destination? (Any valid MAIL destination list surrounded by /"s)|))
(TERPRI)
(SETQ DEST (READ)))
(T (SETQ DEST (EVAL(CAR L))) (SETQ L (CDR L))))
(COND
((NULL L)
(PRINC (QUOTE |Message? (surrounded by /"s)|))
(TERPRI)
(SETQ MESSAGE (READ)))
(T (SETQ MESSAGE (EVAL(CAR L)))))
(MAIL1 DEST MESSAGE)
(TERPRI)
(RETURN (QUOTE (Message sent to MAIL)))))
FEXPR)
(DEFUN MAIL1 (DEST MESSAGE)
(APPLY 'UWRITE '(DSK (RMD SYS)))
((lambda(ār āw)
(PRINC '|MAIL//SUBJEC |)
(PRINC DEST)
(TERPRI)
(PRINC(ASCII(+ 6 6)))
(PRINC '|From |)
(PRINC (CADR (STATUS UNAME)))
(PRINC '| via maclsp|)
(TERPRI)
(TERPRI)
(PRINC MESSAGE)
(TERPRI)
(TERPRI)
(APPLY 'UFILE (LIST
(IMPLODE(APPEND
(EXPLODE(CADR(STATUS UNAME)))
(CDDR(EXPLODE(GENSYM)))))
'FTP)))
t t)
(APPLY 'CRUNIT (LIST 'DSK (STATUS UDIR)))
)